home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
newstart
/
newst1.frm
< prev
next >
Wrap
Text File
|
1995-09-06
|
14KB
|
626 lines
VERSION 2.00
Begin Form Form1
BackColor = &H00FFFF00&
Caption = "NewStart Version 1.04"
ClientHeight = 4560
ClientLeft = 1080
ClientTop = 1590
ClientWidth = 7635
ForeColor = &H00FFFF00&
Height = 5250
Icon = NEWST1.FRX:0000
Left = 1020
LinkMode = 1 'Source
LinkTopic = "Form1"
ScaleHeight = 4560
ScaleWidth = 7635
Top = 960
Width = 7755
Begin PictureBox Picture1
BackColor = &H00FFFF00&
BorderStyle = 0 'None
Height = 615
Left = 1800
Picture = NEWST1.FRX:0302
ScaleHeight = 615
ScaleWidth = 1095
TabIndex = 3
Top = 3480
Width = 1095
End
Begin OptionButton Option2
BackColor = &H00FFFF00&
Caption = "View"
ForeColor = &H00000000&
Height = 255
Left = 5520
TabIndex = 6
Top = 3240
Width = 975
End
Begin OptionButton Option1
BackColor = &H00FFFF00&
Caption = "Change"
ForeColor = &H00000000&
Height = 255
Left = 5520
TabIndex = 5
Top = 2760
Value = -1 'True
Width = 975
End
Begin CommandButton microsoft_button
Caption = "&Restore Microsoft Logo"
Height = 615
Left = 4800
TabIndex = 10
Top = 1800
Width = 2295
End
Begin CommandButton exit_button
Caption = "E&xit"
Height = 735
Left = 6240
TabIndex = 9
Top = 960
Width = 855
End
Begin CommandButton Kill_button
Caption = "&Delete"
Height = 735
Left = 4800
TabIndex = 8
Top = 960
Width = 855
End
Begin DirListBox Dir1
BackColor = &H00FF0000&
ForeColor = &H00FFFFFF&
Height = 2415
Left = 120
TabIndex = 1
Top = 480
Width = 2415
End
Begin CommandButton execute_button
Caption = "&Execute"
Default = -1 'True
Height = 495
Left = 4800
TabIndex = 7
Top = 360
Width = 2295
End
Begin FileListBox File1
BackColor = &H0000FF00&
ForeColor = &H00000000&
Height = 2760
Left = 2520
Pattern = "*.rle"
TabIndex = 0
Top = 120
Width = 1695
End
Begin DriveListBox Drive1
BackColor = &H0000FFFF&
ForeColor = &H00000000&
Height = 315
Left = 120
TabIndex = 2
Top = 120
Width = 2415
End
Begin Label Label3
BackColor = &H00FFFF00&
Caption = "NewStart Version 1.04"
FontBold = -1 'True
FontItalic = -1 'True
FontName = "MS Serif"
FontSize = 18
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 375
Left = 120
TabIndex = 4
Top = 3000
Width = 5055
End
Begin Menu AboutName
Caption = "&About"
End
Begin Menu HelpName
Caption = "&Help"
Begin Menu me_help
Caption = "&Index"
Index = 1
End
Begin Menu me_help
Caption = "&Using Help"
Index = 2
End
End
End
Const FILEBOXCLICK = 0, DIRSBOXCLICK = 1
Dim Lastchange As Integer
Sub AboutName_Click ()
AboutBox.Show modal
End Sub
Sub Dir1_Change ()
On Error GoTo path_errors
file1.path = dir1.path
file1.SetFocus
If file1.ListCount Then
file1.ListIndex = 0
End If
Exit Sub
path_errors:
msg$ = "Error " + Str$(Err) + " " + Error$
MsgBox msg$ ' Display error message.
Exit Sub
End Sub
Sub Dir1_Click ()
Lastchange = DIRSBOXCLICK
End Sub
Sub Drive1_Change ()
On Error GoTo Drive_errors
dir1.path = drive1.Drive
Exit Sub
Drive_errors: ' Error handler line label.
msg$ = "Error " + Str$(Err) + " " + Error$
MsgBox msg$ ' Display error message.
Exit Sub
End Sub
Sub execute_button_click ()
On Error GoTo EXE_Errors
device_type = 0
windir$ = String$(255, " ")
sysdir$ = String$(255, " ")
worked% = GetWindowsDirectory(windir$, Len(windir$))
worked% = GetSystemDirectory(sysdir$, Len(sysdir$))
worked% = GetDeviceCaps(hDC, VERTRES)
Select Case worked%
Case Is >= 480
device_type = 1
Case 350
device_type = 2
Case 348
device_type = 3
Case 200
device_type = 4
Case Else
msg$ = "Unknown display device - can't execute"
MsgBox msg$, 16, "NewStart 1.04"
Exit Sub
End Select
windir$ = LTrim$(RTrim$(windir$))
sysdir$ = LTrim$(RTrim$(sysdir$))
windir$ = Left$(windir$, Len(windir$) - 1)
sysdir$ = Left$(sysdir$, Len(sysdir$) - 1)
If file1.filename <> "" Then
rlepos% = InStr(file1.filename, ".rle")
If rlepos% > 0 Then
ChDrive form1.drive1.Drive
ChDir form1.file1.path
If option2.value Then
form2.Show modal
Else
msg$ = "Change RLE Startup File ?"
resp% = MsgBox(msg$, 4, "NewStart 1.04")
If resp% = 6 Then
screen.mousepointer = 11
newfile% = 2
oldfile% = 1
winfile$ = windir$ + "\WIN.COM"
winbak$ = windir$ + "\WINBAK.COM"
rlefile$ = file1.filename
cnffile$ = sysdir$ + "\WIN.CNF"
Select Case device_type
Case 1
logofile$ = sysdir$ + "\VGALOGO.lgo"
Case 2
logofile$ = sysdir$ + "\EGALOGO.lgo"
Case 3
logofile$ = sysdir$ + "\HERCLOGO.lgo"
Case 4
logofile$ = sysdir$ + "\CGALOGO.lgo"
End Select
filecheck$ = Dir$(winfile$)
If filecheck$ = "" Then
msg$ = winfile$ + " not found"
screen.mousepointer = 0
MsgBox msg$
Exit Sub
End If
filecheck$ = Dir$(cnffile$)
If filecheck$ = "" Then
msg$ = cnffile$ + " not found"
screen.mousepointer = 0
MsgBox msg$
Exit Sub
End If
filecheck$ = Dir$(logofile$)
If filecheck$ = "" Then
msg$ = logofile$ + " not found"
screen.mousepointer = 0
MsgBox msg$
Exit Sub
End If
Open rlefile$ For Binary As oldfile%
rlelen& = LOF(oldfile%)
Close oldfile%
If rlelen& > 63000 Then
screen.mousepointer = 0
msg$ = "RLE File too large"
MsgBox msg$, 16, "NewStart 1.04"
Exit Sub
End If
source$ = winfile$
Open source$ For Binary As #1
whole = LOF(1) \ 32000
part = LOF(1) Mod 32000
buffer$ = String$(32000, 0)
start& = 1
filename$ = winbak$
Open filename$ For Binary As #2
For x = 1 To whole
Get #1, start&, buffer$
Put #2, start&, buffer$
start& = start& + 32000
Next x
buffer$ = String$(part, 0)
Get #1, start&, buffer$
Put #2, start&, buffer$
Close
Open winfile$ For Binary As oldfile%
Open cnffile$ For Binary As newfile%
lenfile& = LOF(newfile%)
buffer$ = String$(lenfile&, " ")
Get newfile%, , buffer$
Put oldfile%, , buffer$
Close newfile%